00100	BEGIN "SOLSYS  -  A SOLAR SYSTEM SIMULATOR  -  SEPTEMBER 1972"
00200	
00300		REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00400		REQUIRE "DPYIII[SYS,BGB]" SOURCE_FILE;
00500		REQUIRE "SAITRG[SYS,BGB]" SOURCE_FILE;
00600	
00700	DEFINE DMS(D,M,S)="(π*((S/60+M)/60+D)/180)";
00800	SAFE ITG ARRAY DPYBUF[1:2500];
00900	REAL XL,XH,YL,YH;
01000	REAL BEAMX,BEAMY,MAGX,MAGY,SOX,SOY;
01100	
01200	SUBR AI(REAL X,Y);
01300		⊂ BEAMX←X*MAGX+SOX;
01400		  BEAMY←Y*MAGY+SOY;⊃;
01500	
01600	SUBR AV(REAL X,Y);
01700	BEGIN
01800		REAL X1,Y1,X2,Y2;
01900		X1←BEAMX;
02000		Y1←BEAMY;
02100		X2←BEAMX←X*MAGX+SOX;
02200		Y2←BEAMY←Y*MAGY+SOY;
02300		AIVECT(X1,Y1);AVECT(X2,Y2);
02400	END;
02500	
02600		DEFINE INCREM(I)="I←I+1";
     

00100	SUBR ARC(REAL R,B,A);
00200	BEGIN
00300		REAL BXSAV,BYSAV; ITG RMAGX;
00400		REAL XX,X,Y,C,S,CX,CY,D; ITG M,N,I;
00500		BXSAV←BEAMX; BYSAV←BEAMY;
00600	
00700	α CENTER OF THE CIRCLE;
00800		CX ← (BEAMX-SOX)/MAGX;
00900		CY ← (BEAMY-SOY)/MAGY;
01000		RMAGX ← ABS(R*MAGX); IF RMAGX≤1 THEN RETURN;
01100	α START OF ARC;
01200		X ← COS(A)*R;
01300		Y ← SIN(A)*R;
01400		AI(CX+X,CY+Y);
01500	
01600	α NUMBER OF STEPS DEPENDS ON CURVATURE AND ARC LENGTH;
01700		M ← IF RMAGX≤4 THEN 4 ELSE
01800		    IF RMAGX≤100 THEN 12 ELSE
01900		    IF RMAGX≤400 THEN 15 ELSE 18;
02000		N ← ABS(M*B/π) MAX 1;
02100	α DELTA RADIANS PER STEP;
02200		D ← B/N;
02300		C ← COS(D);
02400		S ← SIN(D);
02500	α WILL THE CIRCLE BE UNBROKEN;
02600		FOR I←1 TO N DO
02700		BEGIN
02800			XX ← C*X - S*Y;
02900			Y ← C*Y + S*X; X←XX;
03000			AV(CX+X,CY+Y);
03100		END;
03200		BEAMX ← BXSAV; BEAMY ← BYSAV;
03300	END;
     

00100	SUBR RADIAL (REAL R1,R2,W);
00200	BEGIN "RADIAL"
00300		REAL BXSAV,BYSAV;
00400		REAL C,S,CX,CY;
00500		BXSAV ← BEAMX; BYSAV ← BEAMY;
00600		C ← COS(W);
00700		S ← SIN(W);
00800		CX ← (BEAMX-SOX)/MAGX; CY ← (BEAMY-SOY)/MAGY;
00900		IF R1≠R2 ∧ ABS(R2-R1)≤4 THEN RETURN;
01000		AI(CX+C*R1,CY+S*R1); IF R1=R2 THEN RETURN;
01100		AV(CX+C*R2,CY+S*R2);
01200		BEAMX ← BXSAV; BEAMY ← BYSAV;
01300	END "RADIAL";
     

00100	α DATA SOURCE - ASTROPHYSICAL QUANTITIES, C.W.ALLEN, 1955;
00200	
00300	α PLANET NAMES;
00400		PRELOAD_WITH "SUN",
00500			"MERCURY","VENUS","EARTH",
00600			"MARS","JUPITER","SATURN",
00700			"URANUS","NEPTUNE","PLUTO";
00800		STRING ARRAY PLANET[0:9];
00900	
01000	α SEMI-MAJOR AXIS OF ORBIT IN AU'S;
01100		PRELOAD_WITH 0,
01200			0.387099, 0.723332, 1.000,
01300			1.52369,  5.2028,   9.540,
01400			19.18,    30.07,    39.44;
01500		REAL ARRAY RADIUS[0:9];
01600	
01700	α MEAN DAILY MOTION IN SECONDS OF ARC;
01800		DEFINE SEC=".4848136811@-5";
01900		PRELOAD_WITH
02000			14732.4202*SEC, 5767.671*SEC, 3548.1926*SEC,
02100			1886.5186*SEC,  299.1278*SEC, 120.456*SEC,
02200			42.234*SEC,     21.53*SEC,    14.29*SEC;
02300		REAL ARRAY SPEED[1:9];
02400	
02500	α MEAN LONGITUDE OF PLANET AT NOON 1 JANUARY 1950;
02600		PRELOAD_WITH
02700			DMS(33,10,06), DMS(81,34,19), DMS(99,35,18),
02800			DMS(144,20,07),DMS(316,09,34),DMS(158,18,13),
02900			DMS(98,18,31), DMS(194,57,08),DMS(165,36,09);
03000		REAL ARRAY POSITION[1:9];
     

00100		REAL DATE;
00200		ITG  SECOND,MINUTE,HOUR,DAY,MONTH,YEAR;
00300	
00400	α NAMES OF THE MONTHS;
00500		PRELOAD_WITH
00600			"JAN", "FEB", "MAR",
00700			"APR", "MAY", "JUN",
00800			"JUL", "AUG", "SEP",
00900			"OCT", "NOV", "DEC";
01000		STRING ARRAY NMONTH[1:12];
01100	
01200	α LENGTH OF THE MONTHS - "30 DAYS HATH SEPTEMBER...";
01300		PRELOAD_WITH
01400			31,28,31, 30,30,30, 31,31,30, 31,30,31;
01500		ITG ARRAY LMONTH[1:12];
01600	
01700	SUBR UPDATE;
01800	BEGIN "UPDATE"
01900		DATE←DATE+1;
02000		DAY←DAY+1;
02100		IF DAY > LMONTH[MONTH] THEN ⊂ DAY←1; INCREM(MONTH);⊃;
02200		IF MONTH > 12 THEN ⊂ MONTH←1; INCREM(YEAR);
02300		LMONTH[2]← IF (YEAR MOD 4)=0 THEN 29 ELSE 28; ⊃;
02400	
02500		AIVECT(200,470);
02600		DPYSST((IF DAY≤9 THEN " "ELSE"")&
02700			CVS(DAY)&" "&NMONTH[MONTH]&" "&CVS(YEAR));
02800	END "UPDATE";
     

00100	α SIGNS OF THE ZODIAC;
00200		PRELOAD_WITH
00300			"ARIES ", "TAURUS", "GEMINI", "CANCER",
00400			"LEO", "VIRGO", "LIBRA", "SCORPIO",
00500			"SAGITTARIUS", "CAPRICORNUS", "AQUARIUS", "PISCES";
00600		STRING ARRAY ZODIAC[1:12];
     

00100	SUBR INITIALIZATION;
00200	BEGIN
00300	ITG I;
00400		DPYSET(DPYBUF);
00500		MAGX ← MAGY ← 1;
00600		FOR I←1 TO 9 DO ARC(50*I,2*π,0);
00700		AIVECT(-511,-511);
00800		AVECT(511,-511);
00900		AVECT(511,511);
01000		AVECT(-511,511);
01100		AVECT(-511,-511);
01200	
01300		DPYBIG(1);
01400		FOR I←0 TO 11 DO 
01500		⊂ AIVECT(490*COS(2*π*I/12) -  5*LENGTH(ZODIAC[I+1]),
01600			 490*SIN(2*π*I/12));
01700		DPYSST(ZODIAC[I+1]);⊃;DPYBIG(2);
01800		DPYOUT(0);
01900	
02000		FOR I←1 TO 50 DO OUTSTR(↓);
02100		DAY←1; MONTH←1; YEAR←1950;
02200	END;
     

00100	SUBR SUNCENTERED;
00200	BEGIN
00300		ITG I; REAL C,S,W;
00400		AIVECT(0,0);DPYSST("SUN");
00500		FOR I←1 TO 9 DO
00600		BEGIN
00700			W ← POSITION[I];
00800			C ← COS(W)*50*I;
00900			S ← SIN(W)*50*I;
01000			AIVECT(C-4,S);AVECT(C+4,S);
01100			AIVECT(C,S-4);AVECT(C,S+4);
01200			AIVECT(C,S);
01300			DPYSST(PLANET[I]);
01400		END;
01500	
01600	END;
     

00100	SUBR XCENTERED(ITG J);
00200	BEGIN
00300		REAL X,Y,X0,Y0,W,R; ITG I;
00400	
00500		X0 ← COS(POSITION[J])*RADIUS[J];
00600		Y0 ← SIN(POSITION[J])*RADIUS[J];
00700		AIVECT(0,0);DPYSST(PLANET[J]);
00800	
00900		PLANET[J] ↔ PLANET[0];
01000		RADIUS[J] ↔ RADIUS[0];
01100	
01200		FOR I←1 TO 9 DO
01300		BEGIN
01400			W ← POSITION[I];
01500			X ← COS(W)*RADIUS[I] - X0;
01600			Y ← SIN(W)*RADIUS[I] - Y0;
01700			R ← (I*50)/SQRT(X↑2 + Y↑2);
01800			X ← X*R; Y ← Y*R;
01900			AIVECT(0,0);AVECT(X,Y);DPYSST(PLANET[I]);
02000		END;
02100	
02200		PLANET[J] ↔ PLANET[0];
02300		RADIUS[J] ↔ RADIUS[0];
02400	END;
     

00100		INITIALIZATION;
00200	WHILE TRUE DO
00300	BEGIN
00400		ITG I,CHR,ICHR; REAL C,S,W;
00500		IF CHR=0 THEN CHR←"S";
00600		DPYSET(DPYBUF);
00700		IF CHR="S" THEN	SUNCENTERED ELSE XCENTERED(CHR LAND '17);
00800		FOR I←1 TO 9 DO POSITION[I] ← POSITION[I]+SPEED[I];
00900		UPDATE;
01000		DPYOUT(1);
01100		ICHR ← INCHRS; IF ICHR>0 THEN CHR←ICHR;
01200	END;
01300	END;